/* REXX _makeplanet.zrx by the reverend (build 98)                            */
/*-       built by rev-builder version 1.1 on 02 Jan 2003 at 11:11:14        -*/
/*- ------------------------------------------------------------------------ -*/
/*-                       Copyright (C) 2001 Ron Wilson                      -*/
/*-                                                                          -*/
/*- This script is free, and can be modified for your personal use, but you  -*/
/*- cannot copy or distribute this script or any derivative work based upon  -*/
/*- this script without the express permission of the author. Your use of    -*/
/*- this script is governed by the terms of the REV-LICENSE.                 -*/
/*-                                                                          -*/
/*- This program is provided to you WITHOUT ANY WARRANTY, even the implied   -*/
/*- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -*/
/*- REV-LICENSE for more details.                                            -*/
/*-                                                                          -*/
/*-                A copy of the REV-LICENSE is available at:                -*/
/*-       http://thereverend.coastgames.com/tradewars/rev-license.html       -*/
/*- ------------------------------------------------------------------------ -*/
/* description:  make a planet of your choice.                                */
/* rev. 0 - initial release                                                   */

call zoctimeout 30
call zocsynctime 500
globals=_setglobals()
call on halt name _halt

if \_pcheck("Command [") then call _error "please start at the command prompt."

parse value _getinfo("atmdt;gtorp") with acount ";" tcount

typelist=zocask("type of planet? (case sensitive)","Vol;Ocea;Mount")
if typelist="##CANCEL##" then call _quit "script cancelled by user."

if _yesno("start by detonating a planet?") then do
 planet=_planet(0, "zdy")
 acount=acount-1
end /*if*/

planet=0
done=0
do while \done
 call zocsend "uy"
 tcount=tcount-1
 if tcount=0 then done=1
 if zocwait("name this planet? (")=640 then call _error "timeout"
 if zocwait(")")=640 then call _error "timeout"
 if _listinstr(typelist,_lastline()) then call _quit "desired planet created."
 else do
  call zocsend ".^Mp"
  if zocwait("Command [")=640 then call _error "timeout"
  if acount>0 then do
   planet=_planet(planet, "zdy")
   acount=acount-1
  end /*if*/
  else done=1
 end /*else*/
end /*do*/

call _quit tcount||" torpedoes, "||acount||" detonators."

exit

/***                 THE REVEREND'S TW LIBRARY FOR ZOC/REXX                 ***/

/** _setglobals v.3 **/
    _setglobals: procedure expose _verbose _monthdays _monthnames _baseday. (globals)
    
     _verbose=0
     _monthdays="31;28;31;30;31;30;31;31;30;31;30;31"
     _monthnames="jan;feb;mar;apr;may;jun;jul;aug;sep;oct;nov;dec"
     _baseday.2000=730118
     _baseday.2001=_baseday.2000+365+1
     _baseday.2002=_baseday.2001+365
     _baseday.2003=_baseday.2002+365
     _baseday.2004=_baseday.2003+365
     _baseday.2005=_baseday.2004+365+1
     _baseday.2006=_baseday.2005+365
     _baseday.2007=_baseday.2006+365
     _baseday.2008=_baseday.2007+365
    
     rslt="_g. _s. _p. _d. _v. _f. _m. _q. "
     rslt=rslt||"_ef. _es. _et. _ep. "
     rslt=rslt||"_path. _dist. _dtomsl. _dfrmsl. "
     rslt=rslt||"_bg. _nwi. _od. _sv. _pv. _bust. _vs. _vn. "
     rslt=rslt||"_olist1. _olist2. _clvlist1. _clvlist2. "
     rslt=rslt||"_verbose _monthdays _monthnames _baseday. "
     rslt=rslt||"globals reconnect scriptname lra "
     if arg(1,"E") then rslt=rslt||arg(1)
    
     rslt=_space(rslt)
    return rslt

/** _halt v.3 **/
    _halt: procedure expose (globals)
     call off halt
     call zocwriteln "^[[1;33m< user abort >^[[0m "
     exit
    return

/** _pcheck v.4 **/
    _pcheck: procedure expose (globals)
     pc1=arg(1)
     pc2=zocgetscreen(0, zocgetinfo("CURSOR-Y"), zocgetinfo("CURSOR-X"))
     rslt=0
     do i=1 to _dwords(pc1,";")
      if _instr(_dword(pc1,i,";"),pc2,"cs") then rslt=1
     end /*do*/
    return rslt

/** _error v.7 **/
    _error: procedure expose (globals)
     call off halt
     if zocgetinfo("CURSOR-X")>0 then call zocwriteln
     call zocwrite _ansi("bt;frd")||"< script error"
     if arg(1,"E") then call zocwrite ": "||arg(1)
     call zocwriteln " >"
     call zocwriteln _ansi("bt;fye")||"< if this is a serious problem, email me at: the.reverend@coastgames.com > "
     call zocwriteln "< ZOC VERSION '"||zocgetinfo("VERSION")||"', OS '"||zocgetinfo("OSYS")||"', LOCATION '"||zocgetinfo("CONNECTEDTO")||"' >"
     if arg(2,"E") then call zocwriteln _ansi("bt;fgr")||"< "||arg(2)||" >"
     call zocwrite _ansi()
     call _beep "error.wav"
     if reconnect=1 & arg(1)="timeout" then do
      /* call zocdisconnect */
      call zocwriteln _ansi("bt;fwh")||"< ATTEMPTING TO RECONNECT >"
      call zocdostring "^RUN=_connect.zrx sn="||scriptname
     end /*if*/
    exit

/** _getinfo v.5 **/
    _getinfo: procedure expose (globals)
     args=lower(arg(1))
     bufflen=3*1024
     call zocreceivebuf bufflen
     call zocsend "/"
     if zocwait("Sect ")=640 then call _error "timeout"
     if zocwait("Ship ")=640 then call _error "timeout"
     if zocwait("^M")=640 then call _error "timeout"
     buff=translate(zocreceivebuf(0),"  ",d2c(10)||d2c(0))
     if length(buff)>=bufflen then call zocwrite "<buffer overflow>"
     i=pos("Sect ",buff)
     j=pos("Ship",buff,i)
     j=pos(d2c(13),buff,j)
     buff=substr(buff,i,j-i)
     buff=_space(translate(buff, "  ;;", d2c(0)||d2c(10)||d2c(13)||d2c(179)),1)
     buff=translate(_space(translate(buff,", "," ,"),0),", "," ,")
    
     vr.=""
     vl.=""
     c=0
     do j=1 to _dwords(buff,";")
      c=c+1
      vr.c=strip(_dword(buff,j,";"))
      vl.c=word(vr.c,2)
      vr.c=lower(word(vr.c,1))
      if vr.c="ship" then do
       c=c+1
       vr.c=strip(_dword(buff,j,";"))
       vl.c=word(vr.c,3)
       vr.c="shiptype"
      end /*if*/
     end /*do*/
    
     rslt=""
     do i=1 to _dwords(args,";")
      found=0
      do j=1 to c
       if vr.j=_dword(args,i,";") then do
        rslt=rslt||";"||vl.j
        found=1
       end /*if*/
      end /*do*/
      if \found then rslt=rslt||";"||"##NA##"
     end /*do*/
     if rslt\="" then rslt=substr(rslt,2)
    
    return rslt

/** _quit v.7 **/
    _quit: procedure expose (globals)
     lcpy=1
     arg1=""
     do i=1 to 2 /* manage arguments */
      select
       when arg(i,"E") & lower(arg(i))="nocopy" then lcpy=0
       when arg(i,"E") & arg1="" then arg1=arg(i)
       otherwise nop
      end /*select*/
     end /*do*/
     line=zocgetscreen(0, zocgetinfo("CURSOR-Y"), zocgetinfo("CURSOR-X"))
     select /* define message */
      when  lcpy & arg1="" then msg="^[[1;32m< end script >^[[0m^M^J"||line
      when \lcpy & arg1="" then msg="^[[1;32m< end script >^[[0m "
      when  lcpy           then msg="^[[1;32m^M^J< end script: "||arg1||" >^[[0m^M^J"||line
      when \lcpy           then msg="^[[1;32m^M^J< end script: "||arg1||" >^[[0m "
      otherwise nop
     end /*select*/
     call zocwrite msg
     select /* choose a beep */
      when lower(arg1)="script cancelled by user." then call _beep "cancel.wav"
      otherwise call _beep "quit.wav"
     end /*select*/
     exit
    return 1

/** _yesno v.3 **/
    _yesno: procedure expose (globals)
     if arg(1,"E") then msg=arg(1)
     else msg="yes or no"
     if arg(2)="yn" then rslt=zocrequest(msg||" (ESC=no)", "yes", "no")
                    else rslt=zocrequest(msg, "yes", "no", "cancel")
     select
      when rslt="cancel" then call _quit "script cancelled by user.", "nocopy"
      when rslt="##CANCEL##" & arg(2)\="yn" then call _quit "script cancelled by user.", "nocopy"
      when rslt="yes" then rslt=1
      otherwise rslt=0
     end /*select*/
    return rslt

/** _planet v.11 **/
    _planet: procedure expose (globals)
     planet=arg(1)
     if planet="" then planet=0
     comm=arg(2)
     msg=arg(3)
     if msg="" then msg="which planet?"
     mode=arg(4)
    
    /* MESSAGES TO ACCOUNT FOR:                          */
    /* They don't have room for that many on the planet! */
    /* Planetary Attack Command [Q] */
    
     list=""
     scanner=0
    
     call zocsend "l"
     rslt="l"
    
     done=0
     prompt=0
     do while \done
      ans=zocwaitmux("Planet command", ,
                     "Land on which planet", ,
                     "   <", ,
                     "There isn't a planet in this sector.", ,
                     "Citadel RLvl Fighters", ,
                     "couldn't possibly stand the stress", ,
                     " in sector ")
      select
       when ans=0 then done=1
       when ans=1 & prompt then nop
       when ans=1 then do
        prompt=1
        if planet=0 then do
         if pos(";",list)>0 then planet=_drequestlist(msg, list, ";", "c")
         else planet=list
         parse var planet planet "-" .
         planet=strip(planet)
        end /*if*/
        if comm="" then do
         call zocsend "q^M"
         rslt=rslt||"q^M"
         done=1
        end /*if*/
        else do
         call zocsend planet||"^M"
         rslt=rslt||planet||"^M"
        end /*else*/
       end /*when*/
       when ans=2 then do
        if planet=0 then do
         if scanner then do
          if zocwait("%")=640 then call _error "timeout"
         end /*if*/
         else if zocwait("^M")=640 then call _error "timeout"
         line=strip(_lastline())
         parse var line num "> " name
         name=strip(left(name,36))
         if list="" then list=num||copies(" ",2*(4-length(num)))||" - "||name
         else list=list||";"||num||copies(" ",2*(4-length(num)))||" - "||name
        end /*if*/
       end /*when*/
       when ans=3 then do
        planet=0
        done=1
       end /*when*/
       when ans=4 then scanner=1
       when ans=5 then do
        planet=0
        done=1
       end /*when*/
       when ans=6 then do
        if planet=0 then do
         parse value _lastline() with . "#" planet " in sector" .
        end /*if*/
       end /*when*/
       when ans=640 then call _error "timeout"
       otherwise nop
      end /*select*/
     end /*do*/
    
     if ans=0 then do
      if mode="quant" then do
       buflen=3*1024
       call zocreceivebuf buflen
       call zocsend "d"
       if zocwait("Planet #")=640 then call _error "timeout"
       if zocwait("Fighters")=640 then call _error "timeout"
       buff=translate(zocreceivebuf(0),"  ",d2c(0)||d2c(10))
       if length(buff)=buflen then call _error "buffer overflow"
       i=pos("Fuel Ore",buff)
       if i>0 then j=pos(d2c(13),buff,i)
       else j=0
       if i>0 & j>0 then parse value substr(buff,i,j-i) with "Fuel Ore" . . . ore .
       else ore=0
       ore=_space(translate(ore," ",","),0)
    
       i=pos("Organics",buff)
       if i>0 then j=pos(d2c(13),buff,i)
       else j=0
       if i>0 & j>0 then parse value substr(buff,i,j-i) with "Organics" . . . org .
       else org=0
       org=_space(translate(org," ",","),0)
    
       i=pos("Equipment",buff)
       if i>0 then j=pos(d2c(13),buff,i)
       else j=0
       if i>0 & j>0 then parse value substr(buff,i,j-i) with "Equipment" . . . equ .
       else equ=0
       equ=_space(translate(equ," ",","),0)
      end /*if*/
    
      if comm="" then do
       call zocsend "q"
       rslt=rslt||"q"
       if zocwait("Command [")=640 then call _error "timeout"
      end /*if*/
      else do
       do while comm\=""
        parse var comm c1 ";" comm
        call zocsend c1||"@"
        rslt=rslt||c1
        if zocwait("Average Interval Lag:")=640 then call _error "timeout"
       end /*do*/
       ans2=zocwaitmux("Planet command", "Command [")
       select
        when ans2=0 then do
         call zocsend "q"
         rslt=rslt||"q"
         if zocwait("Command [")=640 then call _error "timeout"
        end /*when*/
        when ans2=1 then nop
        when ans2=640 then call _error "timeout"
        otherwise nop
       end /*select*/
      end /*else*/
    
     end /*if*/
    
     /* if not learn mode then return planet number */
     select
      when lower(mode)="learn" then rslt=planet||";"||rslt
      when lower(mode)="quant" then rslt=planet||";"||ore||";"||org||";"||equ
      otherwise rslt=planet
     end /*select*/
    
    return rslt

/** _listinstr v.3 **/
    _listinstr: procedure expose (globals)
     if \arg(1,"E") | \arg(2,"E") then call _error "missing parameter in _listinstr"
     abbrlist=arg(1)
     archetype=arg(2)
     if arg(3,"E") then mode=arg(3)
     else mode=""
     if arg(4,"E") then delim=left(arg(4),1)
     else delim=";"
     if mode\="cs" then do
      abbrlist=lower(abbrlist)
      archetype=lower(archetype)
     end /*if*/
     rslt=0
     if archetype="" then rslt=1
     else do
      do i=1 to _dwords(abbrlist,delim)
       if pos(_dword(abbrlist,i,delim), archetype)>0 then do
        rslt=1
        leave
       end /*if*/
      end /*do*/
     end /*else*/
    return rslt

/** _lastline v.3 **/
    _lastline: procedure expose (globals)
     rslt=zoclastline()
     select
      when lower(arg(1))="raw" then nop
      when pos(d2c(7),rslt)>0  then rslt=translate(zocstring("REMOVE", rslt, d2c(7)),"  ",d2c(0)||d2c(10))
      otherwise                     rslt=translate(rslt,"  ",d2c(0)||d2c(10))
     end /*select*/
    return rslt

/** _space v.1 **/
    _space: procedure expose (globals)
     str=strip(arg(1))
     if arg(2,"E") then n=arg(2); else n=1
     if arg(3,"E") then pad=arg(3); else pad=" "
     rslt=word(str,1)
     do i=2 to words(str)
      rslt=rslt||copies(pad,n)||word(str,i)
     end /*do*/
    return rslt

/** _dwords v.2 **/
    _dwords: procedure expose (globals)
     rslt=words(translate(arg(1),arg(2)||" "," "||arg(2)))
    return rslt

/** _instr v.3 **/
    _instr: procedure expose (globals)
     fnd=arg(1)
     str=arg(2)
     if lower(arg(3))\="cs" then do
      fnd=lower(fnd)
      str=lower(str)
     end /*if*/
     if arg(1,"E") & arg(2,"E") & pos(fnd,str)>0 then rslt=1
     else rslt=0
    return rslt

/** _dword v.2 **/
    _dword: procedure expose (globals)
     rslt=translate(word(translate(arg(1),arg(3)||" "," "||arg(3)),arg(2))," "||arg(3),arg(3)||" ")
    return rslt

/** _ansi v.3 **/
    _ansi: procedure expose (globals)
     rslt="0"
     do i=1 to _dwords(arg(1),";")
      w=_dword(arg(1),i,";")
      select
       when w="dl"  then rslt=rslt||";"||0  /* dull               */
       when w="bt"  then rslt=rslt||";"||1  /* bright             */
       when w="ul"  then rslt=rslt||";"||4  /* underlined         */
       when w="blk" then rslt=rslt||";"||5  /* blinking           */
       when w="fbk" then rslt=rslt||";"||30 /* black foreground   */
       when w="frd" then rslt=rslt||";"||31 /* red foreground     */
       when w="fgr" then rslt=rslt||";"||32 /* green foreground   */
       when w="fye" then rslt=rslt||";"||33 /* yellow foreground  */
       when w="fbl" then rslt=rslt||";"||34 /* blue foreground    */
       when w="fmg" then rslt=rslt||";"||35 /* magenta foreground */
       when w="fcy" then rslt=rslt||";"||36 /* cyan foreground    */
       when w="fwh" then rslt=rslt||";"||37 /* white foreground   */
       when w="bbk" then rslt=rslt||";"||40 /* black background   */
       when w="brd" then rslt=rslt||";"||41 /* red background     */
       when w="bgr" then rslt=rslt||";"||42 /* green background   */
       when w="bye" then rslt=rslt||";"||43 /* yellow background  */
       when w="bbl" then rslt=rslt||";"||44 /* blue background    */
       when w="bmg" then rslt=rslt||";"||45 /* magenta background */
       when w="bcy" then rslt=rslt||";"||46 /* cyan background    */
       when w="bwh" then rslt=rslt||";"||47 /* white background   */
       otherwise nop
      end /*select*/
     end /*do*/
     rslt="^[["||rslt||"m"
    return rslt

/** _beep v.2 **/
    _beep: procedure expose (globals)
     select
      when arg(1,"O") then call zocwrite d2c(7)
      when _fileexists(arg(1)) then call zocplaysound arg(1)
      otherwise call zocwrite d2c(7)
     end /*select*/
    return

/** _drequestlist v.3 **/
    _drequestlist: procedure expose (globals)
     i=zocrequestlist(arg(1),translate(arg(2),"|"||arg(3),arg(3)||"|"))
     select
      when i<0 & lower(arg(4))="c" then call _quit "script cancelled by user.", "nocopy"
      when i<0 then rslt="##CANCEL##"
      otherwise rslt=_dword(arg(2),i+1,arg(3))
     end /*select*/
    return rslt

/** _fileexists v.3 **/
    _fileexists: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _fileexists"
     if stream(arg(1), "C", "QUERY EXISTS")="" then rslt=0; else rslt=1
    return rslt